unit procedur;

interface
uses graph, crt, constant,TPDate;
var CopyAKK, CopyRgD: LongInt;
procedure MBMDraw;
function ReadChar: Char;
procedure Beep;
procedure Initialize;
procedure selectedItemIdxItem(var CurrentElement: integer);
procedure UnselectedItemIdxItem(var CurrentElement: integer);
function WriteHexWord(w: word):  string;
procedure IncDec(CurrentElement: integer;bool: boolean);
procedure IncDecSS(CurrentElement: integer;bool: boolean);
procedure OutCurrentTime(var NewTime,OldTime: longint);
procedure InterpreterMBM;
procedure OutValueRegisterMBM;
procedure Tact;
procedure NewValue;
implementation

function WriteHexWord(w: word):  string;
const HexChars : array [0..$F] of Char = '0123456789ABCDEF';
var HexStr: string[4];
begin
  WriteHexWord:=HexChars[Hi(W) Shr 4]+HexChars[Hi(W) And $F]+HexChars[Lo(W) Shr 4]+HexChars[Lo(W) And $F];
end;

procedure OutValueRegisterMBM;
var i: integer;
    st,st2: string[4];
begin
 for i:=1 to LimitRegisterMBM-1 do
  with RegisterMBM[i] do
   begin
    str(value^,st);
    OutTextXY(x,y,'Hex='+WriteHexWord(value^));
    OutTextXY(x,y+dy,'Dec='+st);
   end;
 with RegisterMBM[LimitRegisterMBM] do
  begin
   str(ZF,st);
   str(CF,st2);
   OutTextXY(x,y,'Bin='+st);
   OutTextXY(x+40,y,st2);
  end;
end;

procedure MBMDraw;
var i: integer;
    st: string[4];
begin
 Rectangle(0,0,GetMaxX,GetMaxY);
 SetColor(lightBlue);
 for i:=1 to LimitMemoryMBM do
  with MemoryMBM[i] do
    Rectangle(x1,y1,x2,y2);
 for i:=1 to LimitDrawMBM do
  with DrawMBM[i] do
   if entity='square' then
    begin
     SetColor(lightGreen);
     Rectangle(x1,y1,x2,y2)
    end
    else
     begin
       SetColor(lightBlue);
       Line(x1,y1,x2,y2);
      end;
 SetColor(lightGreen);
 for i:=1 to LimitTextMBM do
  with TextMBM[i] do
   OutTextXY(x+15,y,txt);
 SetColor(lightMagenta);
 for i:=12 to LimitMemoryMBM do
  with MemoryMBM[i] do
   begin
    if i=12 then str(speedValue,st)
     else str(Step,st);
    OutTextXY(x1+15,y1+dy,'Dec='+st);
   end;
 OutValueRegisterMBM;
 for i:=0 to LimitArrowsMBM do
  with ArrowsMBM[i] do
   if (i=1) or (i=0)
   then
     OutTextXY(x,y,'<')
   else
     OutTextXY(x,y,'>')
end;

procedure selectedItemIdxItem(var CurrentElement: integer);
begin
 SetColor(LightGreen);
 with MemoryMBM[CurrentElement] do
   Rectangle(x1,y1,x2,y2)
end;

procedure UnselectedItemIdxItem(var CurrentElement: integer);
begin
 SetColor(lightBlue);
   with MemoryMBM[CurrentElement] do
   Rectangle(x1,y1,x2,y2)
end;

procedure IncDecSS(CurrentElement: integer;bool: boolean);
var st: string[4];
begin
 with MemoryMBM[CurrentElement] do
  begin
   SetFillStyle(0, LightGreen);
   FloodFill(x1+5,y1+5,LightGreen);
   SetColor(LightRed);
   if CurrentElement=12 then
    begin
     if bool then Inc(Step)
      else Dec(Step);
     str(Step,st);
     end;
   if CurrentElement=13 then
    begin
     if bool then Inc(speedValue)
      else Dec(speedValue);
      str(speedValue,st);
    end;
   OutTextXY(x1,y1+dy,'Dec='+st);
  end;
end;

procedure IncDec(CurrentElement: integer;bool: boolean);
var st: string[4];
begin
 with RegisterMBM[CurrentElement] do
  begin
    if (CurrentElement= 7 ) or  (CurrentElement= 9 ) then
    begin
      SetFillStyle(0, LightGreen);
      FloodFill(x,y,LightGreen);
      SetColor(LightRed);
      if bool
      then
        Inc(value^,step)
      else
        Dec(value^,step);
      str(value^,st);
      OutTextXY(x,y,'Hex='+WriteHexWord(value^));
      OutTextXY(x,y+dy,'Dec='+st);
    end
    else
      Beep;
  end;

end;

function ReadChar: Char;
var
  Ch: Char;
begin
 Ch := ReadKey;
  if Ch = #0 then
  case readkey of
    #27: Ch := CEsc;      {Esc}
    #43: Ch := CPlus;     {+}
    #44: Ch := CMinus;    {-}
    #45: Ch := CExit;     {Alt-X}
    #9 : Ch := CTab;      {Tab}
    #62: Ch := CNewValue; {F4}
    #67: Ch := CF9;   {F9}
    #65: Ch := CF7;   {F7}
    #102: Ch := CCtrlF9;  {Ctrl-F9}
  end;
 ReadChar := Ch;
end;

procedure Beep;
begin
 Sound(500);
 Delay(25);
 NoSound;
end;

procedure Initialize;
var
   GRDriver, GRMode,ErrCode: integer;
begin
 GRDriver:=Detect;
 GRMode:=1;
 InitGraph(GRDriver, GRMode, 'c:\bp7\src\mbm');
 ErrCode:=GraphResult;
 if ErrCode <> grOk then
  begin
   WriteLn('Graphics Error:', GraphErrorMsg(ErrCode));
   Halt(1);
  end;
end;

procedure OutCurrentTime(var NewTime,OldTime: longint);
begin
 NewTime:=Trunc(meml[$40:$6c]/18.2065);
 if NewTime<>OldTime then
  begin
   if OldTime<>0 then
    begin
     SetColor(0);
     OutTextXY(570, 460, TimeToTimeString('hh:mm:ss', OldTime));
     SetColor(10);
    end;
   OldTime:=NewTime;
   OutTextXY(570, 460, TimeToTimeString('hh:mm:ss', NewTime));
  end;
end;

procedure Add;
begin
 case NT of
   8: RgA:=Aisp;
   9: RgD:=OZUMBM[RgA];
   10: begin
        CopyAKK:=AKK;
        CopyRgD:=RgD;
        AKK:=AKK+RgD;
       end;
   11: begin
        if AKK=0 then ZF:=1
         else ZF:=0;
        Loan:=CopyAKK+CopyRgD;
        Loan:=Loan and not $FFFF;
        if Loan<>0 then CF:=1
         else CF:=0;
       end;
 end;
end;

procedure Sub;
var akkl,rgdl:longint;
begin
 case NT of
   8: RgA:=Aisp;
   9: RgD:=OZUMBM[RgA];
   10: begin
        CopyAKK:=AKK;
        CopyRgD:=RgD;
        akkl:=akk;rgdl:=rgd;
        AKK:=$FFFF and(akkl-rgdl)
       end;
   11: begin
        if AKK=0 then ZF:=1 else ZF:=0;
        Loan:=CopyAKK-CopyRgD;
        Loan:=Loan and not $FFFF;
        if Loan<>0 then CF:=1
         else CF:=0;
       end;
 end;
end;

procedure Loa;
begin
 case NT of
   8: RgA:=Aisp;
   9: RgD:=OZUMBM[RgA];
   10: AKK:=RgD;
   11: if AKK=0 then ZF:=1
        else ZF:=0;
 end;
end;

procedure Sto;
begin
 case NT of
   8: RgA:=Aisp;
   9: RgD:=AKK;
   10: OZUMBM[RgA]:=RgD;
 end;
end;

procedure Jz;
begin
 if ZF=1 then SchK:=Aisp;
end;

procedure Jmp;
begin
 case NT of
   8: RgA:=Aisp;
   9: RgD:=OZUMBM[RgA];
   10: SchK:=RgD;
 end;
end;

procedure _End;
begin
 case NT of
   8: RgA:=Aisp;
   9: RgD:=OZUMBM[RgA];
   10: SchK:=RgD;
   11: State:= State_Default;
 end;
end;

procedure Operation;
begin
 case KOP of
   $00: Add;
   $01: Sub;
   $02: Loa;
   $03: Sto;
   $04: Jz;
   $05: Jmp;
   $06: _End;
 end;
end;

procedure Tact;
begin
 SetColor(Black);
 OutValueRegisterMBM;
 Inc(NT);
 case NT of
   1: RgA:=SchK;
   2: RgD:=OZUMBM[RgA];
   3: RgK:=RgD;
   4: Inc(SchK);
   5: KOP:=RgK shr 8;
   6: ADR:=RgK and $00FF;
   7: Aisp:=SchK and $FF00 or ADR;
   8..11: Operation;
 end;
 if NT=11 then NT:=0;
 SetColor(LightRed);
 OutValueRegisterMBM;
end;

procedure NewValue;
var i: integer;
begin
 SetColor(Black);
 OutValueRegisterMBM;
 State:= State_Default;
 OldState := State_Demo;
 RgA:=0;
 RgD:=0;
 NT:=0;
 AKK:=0;
 SchK:=12;
 RgK:=0;
 ADR:=0;
 KOP:=0;
 Aisp:=0;
 ZF:=0;
 CF:=0;
 Loan:=0;
 CopyAKK:=0;
 for i:=5 to 9 do
  OZUMBM[i]:=0;
 SetColor(LightRed);
 OutValueRegisterMBM;
end;

procedure InterpreterMBM;
begin
 if State<>OldState then
  OldState:=State;
 case State of
  State_Demo: begin
        UnselectedItemIdxItem(selectedItemIdx);
        selectedItemIdx:=13;
        selectedItemIdxItem(selectedItemIdx);
        Delay(9999 div speedValue);
        Tact;
      end;
   State_Step: begin
      Tact;
      State := State_Default;
      end;
  State_Automat: begin
       UnselectedItemIdxItem(selectedItemIdx);
       selectedItemIdx:=13;
       selectedItemIdxItem(selectedItemIdx);
       Tact;
      end;
 end;
end;


end.